home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 4 / FM Towns Free Software Collection 4 - Disc 1.iso / fb386 / bdbc_b / bdbc_b.bas next >
BASIC Source File  |  1991-10-18  |  3KB  |  86 lines

  1. 10 CLS
  2. 20 LOCATE 10,0:PRINT "Black Tool Series vol.2"
  3. 30 LOCATE 0,1:PRINT "Black Dump Basic Convarter V1.1L10b"
  4. 40 WAIT 100
  5. 50 CLS
  6. 10000 CONSOLE 0,0,1
  7. 10100 COLOR 7,0,0
  8. 10200 PRINT "読み込むファイル名を拡張子を付けて入力してください(パス名などは入力しないで下さい)"
  9. 10300 INPUT "",FILENA1$:CLS:IF FILENA1$="" THEN END ELSE IF LEN(FILENA1$)>8 THEN 10200
  10. 10400 COLOR 0,0
  11. 10500 ON ERROR GOTO *FILE_E1:FILES FILENA1$
  12. 10600 COLOR 7,0:CLS:ON ERROR GOTO 0
  13. 10700 PRINT "新しく書き込むファイル名をディスク名、パス名を付けて入力してください(カレントは省略 可:拡張子はいりません)"
  14. 10800 INPUT "",FILENA2$:CLS:IF FILENA2$="" THEN 10000
  15. 10900 COLOR 0,0:FILENA2$=FILENA2$+".BAS"
  16. 11000 ON ERROR GOTO 11200:FILES FILENA2$
  17. 11100 COLOR 7,0:CLS:ON ERROR GOTO 0:GOTO *FILE_E2
  18. 11200 RESUME 11300
  19. 11300 ON ERROR GOTO 0
  20. 11400 FILENA1$="(1)"+FILENA1$
  21. 11500 COLOR 7,0:OPEN "R",#1,FILENA1$
  22. 11600 OPEN "O",#2,FILENA2$
  23. 11700 PRINT #2,"   10 'BMBC V1.1"
  24. 11800 PRINT #2,"   20 CLS:FILENA$="+CHR$(&H22)+FILENA1$+CHR$(&H22)
  25. 11900 FIELD #1,1 AS G$
  26. 12000 RESTORE 17000
  27. 12100 FOR I=0 TO 10
  28. 12200 IF I=1 LI$="   40 OPEN "+CHR$(&H22)+"R"+CHR$(&H22)+",#1,FILENA$" ELSE IF I=4 THEN LI$="   70 READ A$:A$="+CHR$(&H22)+"&H"+CHR$(&H22)+"+A$:A=VAL(A$):A$=CHR$(A)" ELSE READ LI$
  29. 12300 PRINT#2,LI$
  30. 12400 NEXT I
  31. 12500 LMAX=LOF(1)
  32. 12600 PRINT #2,"140 DATA"+STR$(LMAX)
  33. 12700 IMAX=LMAX \ 20
  34. 12800 AMARI=LMAX-(IMAX*20):L=150
  35. 12900 IF IMAX=0 THEN 14100
  36. 13000 FOR I=1 TO IMAX
  37. 13100 P2$="":P1$="":FOR M=1 TO 19
  38. 13200 GET #1:G=ASC(G$):P1$=HEX$(G)
  39. 13300 IF LEN(P1$)=1 THEN P1$="0"+P1$
  40. 13400 P2$=P2$+P1$+","
  41. 13500 NEXT M
  42. 13600 GET#1:G=ASC(G$):P1$=HEX$(G)
  43. 13700 IF LEN(P1$)=1 THEN P1$="0"+P1$
  44. 13800 P2$=P2$+P1$
  45. 13900 PRINT#2,STR$(L)+" DATA "+P2$
  46. 14000 L=L+10:NEXT I
  47. 14100 IF AMARI=0 THEN 15200
  48. 14200 IF AMARI=1 THEN 14800
  49. 14300 P1$="":P2$="":FOR I=1 TO AMARI-1
  50. 14400 GET #1:G=ASC(G$):P1$=HEX$(G)
  51. 14500 IF LEN(P1$)=1 THEN P1$="0"+P1$
  52. 14600 P2$=P2$+P1$+","
  53. 14700 NEXT I
  54. 14800 GET #1:G=ASC(G$):P1$=HEX$(G)
  55. 14900 IF LEN(P1$)=1 THEN P1$="0"+P1$
  56. 15000 P2$=P2$+P1$
  57. 15100 PRINT#2,STR$(L)+" DATA "+P2$
  58. 15200 CLOSE:BEEP
  59. 15300 END
  60. 15400 *FILE_E1
  61. 15500 BEEP:COLOR 7,0
  62. 15600 PRINT FILENA1$+"は存在しません"
  63. 15700 PRINT "何かキーを押して下さい。":WAIT 10
  64. 15800 WHILE INKEY$="":WEND:RESUME 10000
  65. 15900 *FILE_E2
  66. 16000 BEEP:COLOR 7,0
  67. 16100 PRINT FILENA2$+"は既に存在しています。"
  68. 16200 PRINT "上書きしますか?(Y/N)"
  69. 16300 WAIT 10
  70. 16400 K$=INKEY$
  71. 16500 IF K$="Y" OR K$="y" THEN 16800
  72. 16600 IF K$="N" OR K$="n" THEN 10600
  73. 16700 GOTO 16400
  74. 16800 KILL FILENA2$
  75. 16900 GOTO 11300
  76. 17000 DATA "   30 RESTORE:READ LMAX
  77. 17100 DATA "   50 FIELD #1,1 AS P$
  78. 17200 DATA "   60 FOR I=1 TO LMAX
  79. 17300 DATA 
  80. 17400 DATA "   80 LSET P$=A$
  81. 17500 DATA "   90 PUT#1,I
  82. 17600 DATA "  100 NEXT I
  83. 17700 DATA "  110 CLOSE
  84. 17800 DATA "  120 BEEP
  85. 17900 DATA "  130 END
  86.